Pascal Super Library/Pascal Super Library (CW International)(1997).bin/COMM/RPL60/RPLREP.INC

Text File | 1992-12-31 | 13KB | 339 lines

  {*}
  {*source code copyright (c) 1985, by TurboPower Software*}
  {*}
  {*}


  function GetRep(var arg : PatLine; var PatList : PatPtr) : Boolean;
    {-convert argument into a pattern list, pointed to by patlist}
    {return true if successful}

    function MakeRep(var arg : PatLine; Start : Integer; Delim : Char; var PatList : PatPtr) : Integer;
      {-make a pattern list from arg[i], starting at start, ending at delim}
      {return 0 is error, last char position in arg if OK}
    var
      i              : Integer;
      Lastj, j       : PatPtr;
      Done           : Boolean;
      c              : Char;

      procedure AddRep(Tok : Tokens; Lastj : PatPtr; var j : PatPtr; s : LongString);
        {-add a token record to the pattern list}
        {s contains a literal character or an expanded character class}
      begin
        New(j);                   {allocate a new pointer for this token}
        j^.Tok := Tok;            {save token type}
        j^.NexTok := False;       {default to non-alternation}
        j^.NestPtr := nil;        {nestptr and next are filled in later if at all}
        j^.Next := nil;
        Lastj^.Next := j;         {hook up the previous token}
        if (Tok = tLitChar) or (Tok = tDitto) then begin
          j^.One := s[1];
          j^.StrPtr := nil;
        end else begin
          WrL('addrep:can''t happen');
          Halt;
        end;
      end;                        {addrep}

    begin                         {makerep}
      New(PatList);               {starter point for patlist}
      PatList^.Tok := tNil;       {put a nil token at the beginning}
      PatList^.NexTok := False;
      PatList^.Next := nil;       {terminate list in case of nil pattern}
      Lastj := PatList;
      i := Start;                 {start point of pattern string}
      Done := False;
      while not(Done) and (arg[i] <> Delim) and (arg[i] <> EndStr) do begin
        c := arg[i];
        if (c = Ditto) then
          AddRep(tDitto, Lastj, j, '0')
        else begin
          if c = Esc then begin
            {skip over escape character}
            i := Succ(i);
            c := arg[i];
            if (c >= '1') and (c <= '9') then
              {a tagged ditto}
              AddRep(tDitto, Lastj, j, c)
            else case c of
              lSpace : AddRep(tLitChar, Lastj, j, #32);
              lNewline : begin
                           AddRep(tLitChar, Lastj, j, #13);
                           Lastj := j;
                           AddRep(tLitChar, Lastj, j, #10);
                         end;
              lTab : AddRep(tLitChar, Lastj, j, #9);
              lBackSpace : AddRep(tLitChar, Lastj, j, #8);
              lReturn : AddRep(tLitChar, Lastj, j, #13);
              lFeed : AddRep(tLitChar, Lastj, j, #10);
              lInput : AddRep(tLitChar, Lastj, j, #60);
              lOutput : AddRep(tLitChar, Lastj, j, #62);
              lPipe : AddRep(tLitChar, Lastj, j, #124);
              lNil : ;
            else
              AddRep(tLitChar, Lastj, j, c);
            end;
          end else
            AddRep(tLitChar, Lastj, j, c);
        end;
        Lastj := j;
        if not(Done) then i := Succ(i);
      end;                        {of looking through pattern string}
      if Done or (arg[i] <> Delim) then begin
        MakeRep := 0;
        WrL('pattern error detected near end of '+Copy(arg, 1, i));
      end else MakeRep := i;
    end;                          {makerep}

  begin                           {getrep}
    GetRep := (MakeRep(arg, 1, EndStr, PatList) > 0);
  end;                            {getrep}

  procedure SubLine(var Lin : Line; PatRec, RepRec : PatPtr; var Sub : Line);
    {-rescan the line to get flags and multiple substititions}
  var
    NumToAdd, TagNum, i, Lastm, m : Integer;
    tSub           : Line;
    flags          : Flag;
    TagOn, DidReplace : Boolean;

    function aMatch(var Lin : Line; var flags : Flag;
                    OffSet         : Integer;
                    var TagNum     : Integer;
                    Pat            : PatPtr) : Integer;
      {-look for match of pattern list starting at pat with lin.val[offset...]}
      {return the last position that matched}
    var
      i, k, LocTag   : Integer;
      j              : PatPtr;
      Done, Junk     : Boolean;
      tTok           : Tokens;

      function oMatch(var Lin : Line; var flags : Flag;
                      var i, TagNum  : Integer;
                      Pat            : PatPtr) : Boolean;
        {-match one pattern element at pattern pointed to by pat, lin.val[i]}
      var
        Advance        : -1..255;
        tTok           : Tokens;
        k              : Integer;
        c              : Char;
      begin                       {omatch}
        Advance := -1;
        tTok := Pat^.Tok;
          if IgnoreCase then c := UpCaseMac(Lin.Val[i]) else c := Lin.Val[i];

        if c <> EndStr then begin
          if tTok = tLitChar then begin
            if c = Pat^.One then Advance := 1;
          end else if tTok = tCcl then begin
            k := Pos(c, Pat^.StrPtr^);
            if k > 0 then Advance := 1;
          end else if tTok = tnCcl then begin
            if Pos(c, NewLine) = 0 then begin
              k := Pos(c, Pat^.StrPtr^);
              if k = 0 then Advance := 1;
            end;
          end else if tTok = tAny then begin
            if (c <> #13) and (c <> #10) then Advance := 1;
          end else if tTok = tBol then begin
            if i = 1 then Advance := 0;
          end else if tTok = tEol then begin
            if (c = #13) and (Lin.Val[Succ(i)] = #10) then begin
              Advance := 0;
            end;
          end else if tTok = tNil then begin
            Advance := 0;
          end else if tTok = tbTag then begin
            Advance := 0;
            if not(TagOn) then begin
              {WrL('increment tagnum to ',tagnum+1);}
              TagNum := Succ(TagNum);
              TagOn := True;
            end;
          end else if tTok = teTag then begin
            Advance := 0;
            TagOn := False;
          end else if tTok = tGroup then begin
            {we treat a group as a "character", but allow advance of multiple chars}
            {recursive call to amatch}
            k := aMatch(Lin, flags, i, TagNum, Pat^.NestPtr);
            if k >= i then begin
              i := k;
              Advance := 0;
            end;
          end;
        end else begin
          {at end of line}
          {end tag marks match}
          if (tTok = teTag) then Advance := 0;
        end;

        if Advance > 0 then begin
          {we had a match at this (these) character position(s)}
          {set the match flags}
            if TagOn then flags[i] := TagNum else flags[i] := 0;
          i := i+Advance;
          oMatch := True;
        end else if Advance = 0 then begin
          oMatch := True;
        end else begin
          {this character didn't match}
          oMatch := False;
          flags[i] := -1;
        end;
      end;                        {omatch}

    begin                         {amatch}
      Done := False;
      j := Pat;
      while not(Done) and (j <> nil) do begin
        tTok := j^.Tok;
        if tTok = tClosure then begin
          {a closure}
          j := j^.Next;           {step past the closure in the pattern list}
          i := OffSet;            {leave the current line position unchanged}
          LocTag := TagNum;
          {match as many as possible}
          while not(Done) and (Lin.Val[i] <> EndStr) do begin
            if not(oMatch(Lin, flags, i, LocTag, j)) then Done := True;
          end;
          {i points to the location that caused a non-match}
          {match rest of pattern against rest of input}
          {shrink closure by one after each failure}
          Done := False;
          while not(Done) and (i >= OffSet) do begin
            {call amatch recursively}
            k := aMatch(Lin, flags, i, LocTag, j^.Next);
            if k > 0 then
              Done := True
            else begin
              i := Pred(i);
              LocTag := flags[i];
              {WrL('resetting tagnum to ',loctag);}
            end;
          end;
          OffSet := k;            {if k=0 then failure else success}
          TagNum := LocTag;
          Done := True;
        end else if tTok = tMaybeOne then begin
          {a 0 or 1 closure}
          j := j^.Next;           {step past the closure marker}
          {match or no match is ok, but advance lin cursor if matched}
          Junk := oMatch(Lin, flags, OffSet, TagNum, j);
          {advance to the next pattern token}
          j := j^.Next;
        end else if not(oMatch(Lin, flags, OffSet, TagNum, j)) then begin
          if j^.NexTok then begin
            {we get another chance because of alternation}
            j := j^.Next;
          end else begin
            {omatch failed, can't back up}
            OffSet := 0;
            Done := True;
          end;
        end else begin            {omatch succeeded}
          {skip over alternates if we matched already}
          while j^.NexTok and (j^.Next <> nil) do j := j^.Next;
          {move to the next non-alternate}
          j := j^.Next;
        end;
      end;
      aMatch := OffSet;
    end;                          {amatch}

    procedure WriteSub(var Lin : Line; var flags : Flag; RepRec : PatPtr;
                       i, iEnd : Integer; var m : Line);
      {-Wr the output line with replacements}
    var
      TagNum, iStart, iStop : Integer;
      j              : PatPtr;
      Tok            : Tokens;

      function FindTag(var Lin : Line; var flags : Flag; i, iEnd, TagNum : Integer;
                       {-} var iStart, iStop : Integer) : Boolean;
        {-find the tagged match region}
        {return true if it is found}
      begin
        iStart := i;
        while (Lin.Val[iStart] <> EndStr) and (flags[iStart] <> TagNum) do
          iStart := Succ(iStart);
        if flags[iStart] = TagNum then begin
          FindTag := True;
          iStop := iStart;
          while (flags[iStop] = TagNum) and (iStop < iEnd) do
            iStop := Succ(iStop);
        end else FindTag := False;
      end;                        {findtag}

    begin                         {writesub}
      {scan the replacement list}
      m.Length := 0;
      j := RepRec;
      while j <> nil do begin
        Tok := j^.Tok;
        if Tok = tDitto then begin
          TagNum := Ord(j^.One)-Ord('0');
          if TagNum = 0 then begin
            {untagged ditto}
            {add the entire matched region}
            AppendS(m.Val[1], m.Length, Lin.Val[i], iEnd-i, m);
          end else begin
            {tagged ditto}
            {find the tagged region}
            if FindTag(Lin, flags, i, iEnd, TagNum, iStart, iStop) then begin
              {add the tagged region}
              AppendS(m.Val[1], m.Length, Lin.Val[iStart], iStop-iStart, m);
            end                   {else couldn't find tagged word, don't append anything}
            else begin
            end;
          end;
        end else if Tok = tLitChar then
          AppendS(m.Val[1], m.Length, j^.One, 1, m);
        j := j^.Next;
      end;
    end;                          {writesub}

    { I debug.inc}

  begin
    DidReplace := False;
    Lastm := 0;
    i := 1;

    {m:=lin.length;}
    {debug(false);}

    Sub.Length := 0;
    while (Lin.Val[i] <> EndStr) do begin
      TagNum := 0;
      TagOn := False;

      m := aMatch(Lin, flags, i, TagNum, PatRec);

      if (m > 0) and (m <> i) and (Lastm <> m) then begin
        {keep track of count}
        DidReplace := True;
        if wrCnt < 32766 then wrCnt := Succ(wrCnt);
        {debug(true);}
        {replace matched text}
        WriteSub(Lin, flags, RepRec, i, m, tSub);
        Lastm := m;
        AppendS(Sub.Val[1], Sub.Length, tSub.Val[1], tSub.Length, Sub);
      end;

      if (m = 0) or (m = i) then begin
        {no match or null match, append the character}
          if Lin.Val[i] = #13 then NumToAdd := 2 else NumToAdd := 1;
        AppendS(Sub.Val[1], Sub.Length, Lin.Val[i], NumToAdd, Sub);
        i := i+NumToAdd;
      end else                    {skip matched text}
        i := m;

    end;
    if DidReplace then MatchCnt := Succ(MatchCnt);
  end;                            {subline}